home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpstuff2.arc / COLOR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-03-18  |  4.1 KB  |  148 lines
  1. program ColorDemo;
  2.  
  3. {            COLOR DEMONSTRATION PROGRAM  Version 1.00A
  4.  
  5.     This program demonstrates color graphics on the IBM PC and true
  6.     compatibles with a color graphics adapter.
  7.  
  8.     INSTRUCTIONS
  9.     1.  Compile and run the program using the TURBO.COM compiler.
  10.     2.  Toggle between modifying the Palette and the Background by
  11.         typing "P" and "B".
  12.     3.  Change colors by using the up and down arrows on the numeric
  13.         key pad.
  14. }
  15.  
  16. {$I Graph.p  }
  17.  
  18. type
  19.   AnyString = string[40];
  20.  
  21. procedure Check;     { Check to continue to run program }
  22. var
  23.   Ch: char;
  24. begin
  25.   Write('This program will only work if you have');
  26.   WriteLn(' the color graphics adapter installed');
  27.   Write('Continue Y/N ');
  28.   repeat
  29.     Read(Kbd,Ch)
  30.   until UpCase(Ch) in ['Y','N', #27];
  31.   if UpCase(Ch) in ['N', #27] then
  32.     Halt;
  33. end;
  34.  
  35. procedure PaletteDemo;
  36. var
  37.   Ch                        : char;
  38.   PaletteNumber, Background : integer;
  39.   PaletteChange             : boolean;
  40.  
  41.   procedure DrawBoxes;
  42.   var
  43.     Y : integer;
  44.   begin
  45.     FillPattern(10,81,320,104,1);
  46.     FillPattern(10,104,320,128,2);
  47.     FillPattern(10,129,320,154,3);
  48.   end {DrawBoxes};
  49.  
  50.   procedure Msg(X,Y: integer; S: AnyString);
  51.   { write the string S at X,Y }
  52.   begin
  53.     GotoXY(X,Y);
  54.     Write(S);
  55.   end {Msg};
  56.  
  57.   procedure Help;
  58.   begin { write the help text}
  59.     Msg(1,1,'           TURBO COLOR DEMO ');
  60.     Msg(1,3,'Procedures used:');
  61.     Msg(1,6,' To make  background: ');
  62.     Msg(1,7,' To select a palette:  ');
  63.     Msg(1,9,'Colors in selected palette are:');
  64.     Msg(1,12,'1');
  65.     Msg(1,15,'2');
  66.     Msg(1,18,'3');
  67.     Msg(1,21,'Use ' + #24 + ' ' + #25 + ' to change background number');
  68.     Msg(1,22,'or press P to change Palette    ');
  69.     GoToXY(1,25);
  70.     Write('Press ESC to exit');
  71.   end {Help};
  72.  
  73.   procedure Update;
  74.   begin
  75.     GoToXY(22,6); Write('GraphBackground(',Background,') ');
  76.     GoToXY(22,7); Write('Palette(',PaletteNumber,')');
  77.     GraphBackground(Background);
  78.     Palette(PaletteNumber);
  79.     if PaletteChange then
  80.     begin
  81.       Msg(1,21,'Use ' + #24 + ' ' + #25 + ' to change palette number   ');
  82.       Msg(1,22,'Press B to change Background ');
  83.     end
  84.     else
  85.     begin
  86.       Msg(1,21,'Use ' + #24 + ' ' + #25 + ' to change background number');
  87.       Msg(1,22,'or press P to change Palette    ');
  88.     end;
  89.   end {Update};
  90.  
  91. begin {PaletteDemo}
  92.   GraphColorMode;
  93.   BackGround:=0;
  94.   PaletteNumber:=0;
  95.   GraphBackground(BackGround);
  96.   Palette(PaletteNumber);
  97.   DrawBoxes;
  98.   Help;
  99.   Update;
  100.   repeat
  101.     repeat Read(Kbd,Ch) until Ch in ['P','p','B','b',#27];
  102.     case Upcase(Ch) of
  103.       'P': PaletteChange:=true;
  104.       'B': PaletteChange:=false;
  105.       #27: begin
  106.              if KeyPressed then
  107.                begin
  108.                  Read(Kbd,Ch);
  109.                  case Ch of
  110.                    'P': begin
  111.                           if PaletteChange then
  112.                             begin
  113.                               PaletteNumber:=PaletteNumber-1;
  114.                               if PaletteNumber<0 then PaletteNumber:=0;
  115.                             end
  116.                             else
  117.                             begin
  118.                               Background:=BackGround-1;
  119.                               if BackGround<0 then BackGround:=0;
  120.                             end;
  121.                         end;
  122.                    'H': begin
  123.                           if PaletteChange then
  124.                           begin
  125.                             PaletteNumber:=PaletteNumber+1;
  126.                             if PaletteNumber>3 then PaletteNumber:=3;
  127.                           end
  128.                           else
  129.                           begin
  130.                             Background:=BackGround+1;
  131.                             if BackGround>15 then BackGround:=15;
  132.                           end;
  133.                         end;
  134.                  end;
  135.                end;
  136.            end;
  137.     end;
  138.     Update;
  139.   until Ch=#27;
  140. end {Palettedemo};
  141.  
  142. begin {Main program}
  143.   ClrScr;
  144.   Check;
  145.   PaletteDemo;
  146.   TextMode;
  147. end.
  148.